#!/usr/bin/perl -w
# $Id: makerelease 956 2006-01-24 04:20:27Z mjr $

use strict;
use vars qw($forreal);

#
# Configuration.
#
my $version = shift;
my $opt = shift;

die "Usage: $0 <version> [confirm | announce]\n"
  unless defined($version);

die "You do not appear to be a developer.  You cannot use this function\n"
  unless (-d ".svn");

die "The tlily-$version directory must not be present"
  if (-e "tlily-$version");

if ($opt && $opt eq "confirm") {
	$forreal = 1;
	$opt = shift;
} else {
	print "Doing a dry run; run \"$0 $version confirm\" to release.\n";
	$forreal = undef;
}

my $rev = `svnversion .`;
die "This checkout is either not up-to-date, or contains uncommited changes.\n"
  if ($rev !~ m/^\d+$/);

my $url = get_repo_url();
if ($opt && $opt eq "announce") {
	do_announcement($version);
	exit(0);
}


make_version_file($version);
make_changelog($version);
command("svn", "commit",
        "-m", "Automatic update of version and ChangeLog for release.",
	"lib/TLily/Version.pm", "ChangeLog");
command("svn", "update");

my $tag = "/tags/release-" . $version;
$tag =~ s/\./-/g;
command("svn", "cp",
        "-m", "Tag trunk for $version release.",
        ".", "$url$tag");

command("svn", "export", "$url$tag", "tlily-$version");

command("tar", "cvf", "tlily-$version.tar", "tlily-$version");
command("rm", "-rf", "tlily-$version");
command("gzip", "-9", "tlily-$version.tar");

make_version_file($version . "-post");
command("svn", "commit", "-m", "Automatic postcommit of version file.",
	"lib/TLily/Version.pm");

do_announcement($version);

exit 0;


#
# Update TLily::Version.
#
sub make_version_file {
	my($version) = @_;

my $year = 1900 + (localtime())[5];

	my $verfile = <<END
##    TigerLily:  A client for the lily CMC, written in Perl.
##    Copyright (C) 1999-$year  The TigerLily Team, <tigerlily\@tlily.org>
##                             http://www.tlily.org/tigerlily/
##
##  This program is free software; you can redistribute it and/or modify it
##  under the terms of the GNU General Public License version 2, as published
##  by the Free Software Foundation; see the included file COPYING.
##
## Version.pm - Automatically generated by tools/makerelease
#package TLily::Version;
#\$VERSION = '$version';
#1;
END
	    ;
	$verfile =~ s/^\#//gm;

	write_file("lib/TLily/Version.pm", $verfile);

	if ($forreal) {
		chmod(0444, "lib/TLily/Version.pm")
		  or die "Cannot chmod lib/TLily/Version.pm: $!\n";
	}
}


#
# Update the ChangeLog.
#
sub make_changelog {
	my($version) = @_;

	local *CL;
	open(CL, "ChangeLog") or die "ChangeLog: $!\n";
	my @lines = <CL>;
	close CL;

	$lines[0] = "Version $version\n";

	write_file("ChangeLog", join("", @lines));
}


#
# Conditionally write a file.
#
sub write_file {
	my($file, $contents) = @_;

	if (!$forreal) {
		print "$file will be updated:\n";
		print "="x78, "\n", $contents, "="x78, "\n";
	} else {
		print "Writing $file.\n";

		-f $file and unlink $file
		  or die "Cannot unlink $file: $!\n";
	
		local(*FH);
		open(FH, ">$file") or die "$file: $!\n";
		print FH $contents;
		close FH;
	}
}


#
# Figure out repository URL
#
sub get_repo_url {
  open(my $fd, 'svn info|')
    or die "Could not call svn info on current directory: $?\n";

  my $url;
  while (defined(my $line = <$fd>)) {
    chomp($line);
    next unless $line =~ m|^URL: ([^:]+://.+)$|;
    $url = $1;
    last;
  }

  close($fd);

  die "Could not determine repository URL from svn info output.\n"
    unless defined($url);

  die "Can only do a release from the trunk.\n"
    unless ($url =~ s|/trunk$||);

  return $url;
}

#
# Conditionally execute a command.
#
sub command {
	if (!$forreal) {
		print "@_\n";
	} else {
		print "@_\n";
		system(@_);
		my $r = result();
		die "$r\n" if $r;
	}
}


sub result {
	my $exit_value = $? >> 8;
	my $signal_num = $? & 127;
	my $dumped_core = $? & 128;

	if ($signal_num) {
		my $r = "exited due to signal $signal_num";
		$r .= " (core dumped)" if $dumped_core;
		return $r;
	} elsif ($exit_value) {
		return "return code $exit_value";
	}

	return;
}


sub do_announcement {
	my($version) = @_;

	my $inp = &ask("Do you want to send out an announcement?", 'yes');
	if($inp =~ /(y|yes)/i) {
		my $ChangeLog;
		local(*CL);
		open(CL, "ChangeLog") or die "ChangeLog: $!\n";
		my $f;
		while(<CL>) {
			if($f && ! /^Version/) { $ChangeLog .= $_; next; }
			elsif($f && /^Version/) { last; }
			elsif(/^Version\s+$version/) { $f = 1; $ChangeLog = $_; }
		}
		close(CL);

		my $msg = <<END
#From: "The Tigerlily Developers" <tigerlily\@tlily.org>
#To: "Tigerlily Announcement List" <tigerlily-announce\@tlily.org>
#Subject: Tigerlily $version is now available
#
#Hi All -
#
#Tigerlily version $version is now available.
#
#Changes in this release, from the ChangeLog:
#$ChangeLog
#It is available from:
#http://www.tlily.org/tigerlily/
#-- 
#Share and Enjoy.
#
#The Tigerlily Developers
#Albert, Damien, Josh, Matt & Steve.
#----------------------------------------------------------------------------
#To unsubscribe from this list, send email to <majordomo\@tlily.org>
#with the words "unsubscribe tigerlily-announce" in the body.
END
  ;
		$msg =~ s/^\#//mg;

		my $abort_flag;
		my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
		while(1) {
			local(*MSG);
			print $msg;
			my $ans = &ask("(s)end, (e)dit, or (a)bort:", "s");
			last if $ans eq 's';
			if($ans eq 'a') { $abort_flag = 1; last; }
			if($ans eq 'e') {
				open(MSG, ">msgtmp.$$")
				  or die "Cannot open msgtmp.$$ for writing: $!\n";
				print MSG $msg;
				close(MSG);
				system($editor, "msgtmp.$$");
			}
			open(MSG, "msgtmp.$$")
			  or die "Cannot open msgtmp.$$ for reading: $!\n";
			$msg = join("", <MSG>);
			close(MSG);
			unlink("msgtmp.$$") or warn "Cannot unlink msgtmp.$$: $!\n";
		}
		if(!$abort_flag) {
			if(!$forreal) {
				print "Would have sent the message:\n$msg";
				return;
			}
			local(*SM);
			open(SM, "|/usr/sbin/sendmail -t")
			  or die "Couldn't open sendmail: $!";
			print SM $msg;
			close(SM);
		}
	}
}

sub ask {
    $|=1;
    my($q,$d) = @_;
    if(length($q. " [". $d. "]: ") > 80) {
        print $q,"\n[", $d, "]: ";
    }
    else {
        print $q, " [", $d, "]: ";
    }
    my $l = <STDIN>;
    chomp $l;
    $l eq '' ? $d : $l;
}
